home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / delay / TestImpUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-01-27  |  4.2 KB  |  155 lines
  1. unit TestImpUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, HVDll;
  8.  
  9. type
  10.   TDllImportTestForm = class(TForm)
  11.     rgImportMethod: TRadioGroup;
  12.     gbCallProcs: TGroupBox;
  13.     btnRoutine1: TButton;
  14.     btnRoutine2: TButton;
  15.     btnRoutine3: TButton;
  16.     btnRoutine4: TButton;
  17.     gbLogging: TGroupBox;
  18.     LoggingMemo: TMemo;
  19.     gbHVDll: TGroupBox;
  20.     btnLoadDll: TButton;
  21.     btnUnloadDll: TButton;
  22.     btnHook: TButton;
  23.     btnUnhook: TButton;
  24.     procedure btnRoutine1Click(Sender: TObject);
  25.     procedure btnRoutine2Click(Sender: TObject);
  26.     procedure btnRoutine3Click(Sender: TObject);
  27.     procedure btnRoutine4Click(Sender: TObject);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure FormDestroy(Sender: TObject);
  30.     procedure btnUnloadDllClick(Sender: TObject);
  31.     procedure btnLoadDllClick(Sender: TObject);
  32.     procedure btnHookClick(Sender: TObject);
  33.     procedure btnUnhookClick(Sender: TObject);
  34.   private
  35.     procedure DllNotify(Sender: TDll; Action: TDllNotifyAction; Index: integer);
  36.     procedure Log(const Msg: string; Args: array of const);
  37.   end;
  38.  
  39. var
  40.   DllImportTestForm: TDllImportTestForm;
  41.  
  42. implementation
  43.  
  44. {$R *.DFM}
  45.  
  46. uses
  47.   ImpImpTestDll,
  48.   ExpImpTestDll,
  49.   DynLinkTest;
  50.  
  51. const
  52.   ImplicitIdx = 0;
  53.   ExplicitIdx = 1;
  54.   HVDllIdx    = 2;
  55.  
  56. procedure TDllImportTestForm.FormCreate(Sender: TObject);
  57. begin
  58.   Dlls.OnDllNotify := Self.DllNotify;
  59. end;
  60.  
  61. procedure TDllImportTestForm.FormDestroy(Sender: TObject);
  62. begin
  63.   Dlls.OnDllNotify := nil;
  64. end;
  65.  
  66. procedure TDllImportTestForm.btnRoutine1Click(Sender: TObject);
  67. begin
  68.   case rgImportMethod.ItemIndex of
  69.     ImplicitIdx : ImpImpTestDll.Routine1(1, 11, 111, 1111);
  70.     ExplicitIdx : ExpImpTestDll.Routine1(1, 11, 111, 1111);
  71.     HVDllIdx    : DynLinkTest  .Routine1(1, 11, 111, 1111);
  72.   end;
  73. end;
  74.  
  75. procedure TDllImportTestForm.btnRoutine2Click(Sender: TObject);
  76. begin
  77.   case rgImportMethod.ItemIndex of
  78.     ImplicitIdx : ImpImpTestDll.Routine2(2, 22, 222, 2222);
  79.     ExplicitIdx : ExpImpTestDll.Routine2(2, 22, 222, 2222);
  80.     HVDllIdx    : DynLinkTest  .Routine2(2, 22, 222, 2222);
  81.   end;
  82. end;
  83.  
  84. procedure TDllImportTestForm.btnRoutine3Click(Sender: TObject);
  85. begin
  86.   case rgImportMethod.ItemIndex of
  87.     ImplicitIdx : ImpImpTestDll.Routine3(3, 33, 333, 3333);
  88.     ExplicitIdx : ExpImpTestDll.Routine3(3, 33, 333, 3333);
  89.     HVDllIdx    : DynLinkTest  .Routine3(3, 33, 333, 3333);
  90.   end;
  91. end;
  92.  
  93. procedure TDllImportTestForm.btnRoutine4Click(Sender: TObject);
  94. begin
  95.   case rgImportMethod.ItemIndex of
  96.     ImplicitIdx : ImpImpTestDll.Routine4(4, 44, 444, 4444);
  97.     ExplicitIdx : ExpImpTestDll.Routine4(4, 44, 444, 4444);
  98.     HVDllIdx    : DynLinkTest  .Routine4(4, 44, 444, 4444);
  99.   end;
  100. end;
  101.  
  102. procedure TDllImportTestForm.Log(const Msg: string; Args: array of const);
  103. begin
  104.   LoggingMemo.Lines.Add(Format(Msg, Args));
  105. end;
  106.  
  107. procedure TDllImportTestForm.DllNotify(Sender: TDll; Action: TDllNotifyAction; Index: integer);
  108. begin
  109.   case Action of
  110.     daLoadedDll:     Log('Loaded %s', [Sender.FullPath]);
  111.     daUnloadedDll:   Log('Unloaded %s', [Sender.FullPath]);
  112.     daLinkedRoutine: Log('Linked %s.%s', [Sender.FullPath, Sender.EntryName[Index]]);
  113.   end;
  114. end;
  115.  
  116. procedure TDllImportTestForm.btnUnloadDllClick(Sender: TObject);
  117. begin
  118.   TestDll.Unload;
  119. end;
  120.  
  121. procedure TDllImportTestForm.btnLoadDllClick(Sender: TObject);
  122. begin
  123.   TestDll.Load;
  124. end;
  125.  
  126. var
  127.   OldRoutine1 : procedure (A, B, C, D: integer); register;
  128.  
  129. procedure HookedRoutine1(A, B, C, D: integer); register;
  130. begin
  131.   DllImportTestForm.Log('Hooked Routine1 before (%d, %d, %d, %d)', [A, B, C, D]);
  132.   OldRoutine1(A+1, B+1, C+1, D+1);
  133.   DllImportTestForm.Log('Hooked Routine1 after (%d, %d, %d, %d)', [A, B, C, D]);
  134. end;
  135.  
  136. procedure TDllImportTestForm.btnHookClick(Sender: TObject);
  137. begin
  138.   if TestDll.HookRoutine(@@DynLinkTest.Routine1, @HookedRoutine1, OldRoutine1) then
  139.   begin
  140.     btnHook.Enabled := false;
  141.     btnUnhook.Enabled := true;
  142.   end;
  143. end;
  144.  
  145. procedure TDllImportTestForm.btnUnhookClick(Sender: TObject);
  146. begin
  147.   if TestDll.UnHookRoutine(@@DynLinkTest.Routine1, OldRoutine1) then
  148.   begin
  149.     btnHook.Enabled := true;
  150.     btnUnhook.Enabled := false;
  151.   end;
  152. end;
  153.  
  154. end.
  155.